{-# LANGUAGE TypeOperators, FlexibleInstances, TypeFamilies #-}
{- |
Module      :  Survey.WBVR
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2012
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable

-}

module Survey.WBVR
 ( WBVR(..)
 ) where

import Types
import Survey
import Helper               ( isZero, log10 )
import ObsData              ( ObsData(..) )
import Model.Photometry     ( ModelPhotometry(..) )
import Data.HList           ( (:::)(..), Null(..) )
import Control.Monad.Reader ( asks )

-- Обзор
data WBVR = WBVR deriving Show

-- WBVR

instance ObsData (W WBVR, B WBVR, V WBVR, R WBVR) where

  type Data (W WBVR, B WBVR, V WBVR, R WBVR) = (   WB WBVR
                                               ::: WV WBVR
                                               ::: WR WBVR
                                               ::: BV WBVR
                                               ::: BR WBVR
                                               ::: VR WBVR
                                               ::: Null
                                               )

  toInitalData ((W WBVR w), (B WBVR b), (V WBVR v), (R WBVR r)) = return (-- W  WBVR w,
                                                                             WB WBVR (w-b)
                                                                         ::: WV WBVR (w-v)
                                                                         ::: WR WBVR (w-r)
                                                                         ::: BV WBVR (b-v)
                                                                         ::: BR WBVR (b-r)
                                                                         ::: VR WBVR (v-r)
                                                                         ::: Null
                                                                         )

  toModelData _ = mag

--
instance ModelPhotometry (W WBVR) where
  mag = do
     w     <- asks $ w_wbvr . response
     quad' <- asks $ quad . integrator

     let val f = W WBVR $ v + c_w
          where
            v = calcMag $ quad' $ w * f

     return val

instance ModelPhotometry (B WBVR) where
  mag = do
     b     <- asks $ b_wbvr . response
     quad' <- asks $ quad . integrator

     let val f = B WBVR $ v + c_b
          where
            v = calcMag $ quad' $ b * f

     return val

instance ModelPhotometry (V WBVR) where
  mag = do
     v     <- asks $ v_wbvr . response
     quad' <- asks $ quad . integrator

     let val f = V WBVR $ cl + c_v
          where
            cl = calcMag $ quad' $ v * f

     return val

instance ModelPhotometry (R WBVR) where
  mag = do
     r     <- asks $ r_wbvr . response
     quad' <- asks $ quad . integrator

     let val f = R WBVR $ cl + c_r
          where
            cl = calcMag $ quad' $ r * f

     return val

instance ModelPhotometry (WB WBVR) where
  mag = do
     w  <- asks $ w_wbvr . response
     b  <- asks $ b_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = WB WBVR $ cl + c_w - c_b
           where
             cl = calcColor fa fb 
             fa = quad' $ w * f
             fb = quad' $ b * f

     return val

instance ModelPhotometry (WR WBVR) where
  mag = do
     w <- asks $ w_wbvr . response
     r <- asks $ r_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = WR WBVR $ cl + c_w - c_r
           where
             cl = calcColor fa fb 
             fa = quad' $ w * f
             fb = quad' $ r * f

     return val

instance ModelPhotometry (WV WBVR) where
  mag = do
     w <- asks $ w_wbvr . response
     v <- asks $ v_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = WV WBVR $ cl + c_w - c_v
           where
             cl = calcColor fa fb 
             fa = quad' $ w * f
             fb = quad' $ v * f

     return val

instance ModelPhotometry (BV WBVR) where
  mag = do                                    
     b <- asks $ b_wbvr . response
     v <- asks $ v_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = BV WBVR $ cl + c_b - c_v
           where
             cl = calcColor fa fb 
             fa = quad' $ b * f
             fb = quad' $ v * f

     return val

instance ModelPhotometry (BR WBVR) where
  mag = do                                    
     b <- asks $ b_wbvr . response
     r <- asks $ r_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = BR WBVR $ cl + c_b - c_r
           where
             cl = calcColor fa fb
             fa = quad' $ b * f
             fb = quad' $ r * f

     return val

instance ModelPhotometry (VR WBVR) where
  mag = do                                    
     v <- asks $ v_wbvr . response
     r <- asks $ r_wbvr . response

     quad' <- asks $ quad . integrator

     let val f = VR WBVR $ cl + c_v - c_r
           where
             cl = calcColor fa fb
             fa = quad' $ v * f
             fb = quad' $ r * f

     return val

calcMag :: Double -> Maybe Double
calcMag f | isZero f  = Nothing
          | otherwise = Just $ -2.5 * log10 f

--- Вспомогательные функции

c_w, c_b, c_v, c_r :: Val
c_w = -14.397
c_b = -13.107
c_v = -13.838
c_r = -14.323

{--
calcColor fa fb | isZero fa || isZero fb = Nothing
                | otherwise = Just $ -2.5 * log10 $ fa/fb
--}
--{--
calcColor :: Double -> Double -> Maybe Double
calcColor fa fb | isZero fa && isZero fb = Nothing
                | isZero fa = Just $ -777
                | isZero fb = Just $  777
                | otherwise = Just $ -2.5 * log10 $ fa/fb
--}